home *** CD-ROM | disk | FTP | other *** search
/ Network Supervisor's Toolkit / Network Supervisor's Toolkit.iso / tools / nwtp06 / nwintr.pas < prev    next >
Pascal/Delphi Source File  |  1996-07-10  |  22KB  |  762 lines
  1. UNIT NWintr;
  2.  
  3. { DPMI Protected mode calls: Hubert Plattfaut of 2:2447/203.4
  4.   Windows Protected Mode calls:
  5.     -Based on EZDPMI by Julian M. Bucknall [1993: 100116.1572@Compuserve.Com]
  6.     -Based on the NetCalls and WinDPMI units by Siebrand Dijkstra [1995: 2:512/250.595]
  7.     -Corrections by Berend de Boer [1995: berend@beard.nest.nl or 2:281/527.23]
  8.  
  9.   NwTP Version 0.6, 950301, Copyright 1993,1995 R. Spronk
  10. }
  11.  
  12. INTERFACE
  13.  
  14. {$B-,F+,O-,R-,S-,X+}
  15.  
  16. {$DEFINE ProtMode}
  17. {$IFDEF MSDOS}
  18. {$DEFINE RealMode}
  19. {$UNDEF ProtMode}
  20. {$ENDIF}
  21.  
  22. uses
  23. {$IFDEF RealMode} Dos
  24. {$ENDIF}
  25. {$IFDEF DPMI} Dos,WinApi   { we need the GlobalDosAlloc-Function}
  26. {$ENDIF}
  27. {$IFDEF WINDOWS} WinTypes,WinDOS,WinProcs
  28. {$ENDIF};
  29.  
  30. CONST VLM_ID_UNKNOWN  = $0000;   {  non-VLM application }
  31.       VLM_ID_VLM      = $0001;
  32.       VLM_ID_CONN     = $0010;
  33.       VLM_ID_TRAN     = $0020;
  34.       VLM_ID_IPX      = $0021;
  35.       VLM_ID_TCP      = $0022;
  36.       VLM_ID_NWP      = $0030;
  37.       VLM_ID_BIND     = $0031;
  38.       VLM_ID_NDS      = $0032;
  39.       VLM_ID_PNW      = $0033;
  40.       VLM_ID_RSA      = $0034;
  41.       VLM_ID_REDIR    = $0040;
  42.       VLM_ID_FIO      = $0041;
  43.       VLM_ID_PRINT    = $0042;
  44.       VLM_ID_GENR     = $0043;
  45.       VLM_ID_NETX     = $0050;
  46.       VLM_ID_AUTO     = $0060;
  47.       VLM_ID_SECURITY = $0061;
  48.       VLM_ID_NMR      = $0100;
  49.       VLM_ID_DRVPRN   = $09F2;
  50.       VLM_ID_SAA      = $09F5;  { SAA Client API for NetWare }
  51.       VLM_ID_IPXMIB   = $09F6;
  52.       VLM_ID_PNWMIB   = $09F7;
  53.       VLM_ID_PNTRAP   = $09F8;
  54.       VLM_ID_MIB2PROT = $09F9;
  55.       VLM_ID_MIB2IF   = $09FA;
  56.       VLM_ID_NVT      = $09FB;
  57.       VLM_ID_TRAP     = $09FC;
  58.       VLM_ID_REG      = $09FD;
  59.       VLM_ID_ASN1     = $09FE;
  60.       VLM_ID_SNMP     = $09FF;
  61.  
  62. Type
  63. {$ifdef ProtMode}
  64.  
  65.     TTregisters= Record                {This is the data-structure for the}
  66.         Case Byte Of                    {real-mode-interrupts in DPMI-mode}
  67.           0:     {32 bit registers}
  68.             (EDI,ESI,EBP,Reserved,EBX,EDX,
  69.              ECX,EAX:LongInt);
  70.           1:     {16 bit registers}
  71.             (DI,DIHigh,SI,SIHigh,
  72.              BP,BPHigh,ReservedLow,ReservedHigh,
  73.              BX,BXHigh,DX,DXHigh,
  74.              CX,CXHigh,AX,AXHigh,
  75.              Flags,ES,DS,FS,GS,IP,
  76.              CS,SP,SS:Word);
  77.           2:     {8 bit registers}
  78.             (DILowLow,DILowHigh,DIHighLow,DIHighHigh,
  79.              SILowLow,SILowHigh,SIHighLow,SIHighHigh,
  80.              BPLowLow,BPLowHigh,BPHighLow,BPHighHigh,
  81.              ReservedLowLow,ReservedLowHigh,ReservedHighLow,ReservedHighHigh,
  82.              BL,BH,BXHighLow,BXHighHigh,
  83.              DL,DH,DXHighLow,DXHighHigh,
  84.              CL,CH,CXHighLow,CXHighHigh,
  85.              AL,AH,AXHighLow,AXHighHigh:Byte)
  86.         End;
  87.  
  88. {$else} {RealMode}
  89.  
  90.          TTregisters= Record
  91.                       case Integer of
  92.               0: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: Word);
  93.               1: (AL, AH, BL, BH, CL, CH, DL, DH: Byte);
  94.                   end;
  95. {$endif}
  96.  
  97.      TPtrRec=record Ofs,Seg:word end;
  98.  
  99.      TintrBuffer=array[1..576] of byte;
  100.      TPintrBuffer=^TintrBuffer;
  101.  
  102.      TVLMheader=record
  103.                 unknown1             :array[1..4] of byte;
  104.                 ptr1ofs,ptr1seg,      { pointers to 'procedures' }
  105.                 ptr2ofs,ptr2seg,
  106.                 ptr3ofs,ptr3seg,
  107.                 ptr4ofs,ptr4seg      :word;
  108.                 unknown2             :array[1..4] of byte; { 00 00 00 00 }
  109.                 HeaderLen            :byte;  { 1.11-> 4E; 1.20-> 4E}
  110.                 MultiplexIDstring    :array[1..3] of char; { 56 4C 4D 'VLM' }
  111.                 unknown3             :array[1..4] of byte; { 01 00 80 00 }
  112.  
  113.                 TransientSwitchCount :word;
  114.                 CallCount            :word;
  115.                 ControlBlockOfs      :word; { in same segment as this header }
  116.                 CurrentVLMID         :word;
  117.                 MemoryType           :byte; { 04 = XMS }
  118.                 ModulesLoaded        :byte;
  119.                 BlockId              :word;
  120.                 TransientBlock       :word;
  121.                 GlobalSegment        :word;
  122.                 AsyncQueue           :array[1..3] of record { head, tail, s }
  123.                                                      pqofs,pqseg:word;
  124.                                                      end;
  125.                 BusyQueue            :array[1..3] of record { head, tail, s }
  126.                                                      pqofs,pqseg:word;
  127.                                                      end;
  128.                 ReEntranceLevel      :word;
  129.                 FullMapCount         :word;
  130.                 unknown5             :word; { 00 00 }
  131.                 end;
  132.  
  133.      TVLMcontrolBlockEntry=record
  134.                            Flag                      :word;
  135.                            ID                        :word;
  136.                            Func                      :word;
  137.                            Maps                      :word;
  138.                            TimesCalled               :word;
  139.                            unknown1                  :word;  { SSeg ? }
  140.                            TransientSeg,GlobalSeg    :word;
  141.                            AddressLow,AddressHi      :word;
  142.                            TsegSize,GSegSize,SSegSize:word; { in 16 byte paragraphs }
  143.                            VLMname                   :array[1..9] of char;
  144.                                                       { null terminated string }
  145.                            end;
  146.  
  147. Var GlobalReqBuf,GlobalReplyBuf:TPintrBuffer;
  148.  
  149.     { real-mode only, DPMI: all flags are set to false }
  150.     VLM_EXE_loaded :Boolean;
  151.     NETX_VLM_loaded:Boolean; { if true, then VLM_EXE_loaded must also be true. }
  152.     NETX_EXE_loaded:Boolean;
  153.  
  154. Function  RealModeIntr(intNo:byte;Var regs:TTregisters):boolean;
  155. Procedure F2SystemCall(subf:byte;req_size,rep_size:word;Var result:word);
  156. Procedure nwMsDos(VAR R:ttregisters);
  157. Function  InRealMode:Boolean;
  158.  
  159. Function  MapRealmodeSegment(RSeg:Word):Word;
  160. Function  nwPtr(s,o:word):Pointer;
  161. Procedure GetGlobalBufferAddress(VAR Sreq,Oreq,Srep,Orep:Word);
  162.  
  163. {$IFDEF RealMode}
  164. Function GetVLMheader(Var VLMheader:TVLMheader):Boolean;
  165. Function GetVLMControlBlock(Entry:Byte;
  166.                         Var ControlBlock:TVLMControlBlockEntry):Boolean;
  167.                         { entry: 0 .. VLMheader.ModulesLoaded }
  168. {$ENDIF}
  169.  
  170. IMPLEMENTATION {===========================================================}
  171.  
  172. Var GlobalRegisters:TTregisters;  { all Modes ! }
  173.  
  174.     VLMCall:Procedure;
  175.  
  176. {$IFDEF RealMode}
  177.  
  178. Var VLMtransientSeg:word;
  179.  
  180. { ---------- Real mode procedures ------------------------------------}
  181.  
  182. {$F+}
  183.  
  184. Var RequesterProc:Procedure(Var regs:Registers);
  185.    { VLMCall:Procedure; }
  186.  
  187. Procedure VlmSystemCall(Var regs:registers); assembler;
  188. asm
  189. push ds
  190.  
  191.    { check if VLMCall known. If not, return error $FF in fake AL }
  192. xor ah,ah
  193. mov al,$FF
  194. les di,VLMCall
  195. mov bx,es
  196. cmp bx,$0000
  197. je  @1
  198.    { move fake regs registers to 'real' registers }
  199.    { AX, CX, DX, DS, SI, DI, ES only. }
  200. les di,regs
  201. mov ax,es:[di+16]
  202. push ax            { push new es }
  203. mov ax,es:[di+12]
  204. push ax            { push new di }
  205. mov ds,es:[di+14]
  206. mov ax,es:[di]
  207. mov cx,es:[di+4]
  208. mov dx,es:[di+6]
  209. mov si,es:[di+10]
  210. pop di
  211. pop es
  212.    { farr call to VLM handler }
  213. push bp
  214. CALL VLMCall
  215. pop bp
  216. @1: { move 'real' registers to fake regs registers }
  217.  
  218. {push es
  219. push di}
  220. les di,regs
  221. mov es:[di],ax
  222. {mov es:[di+4],cx
  223. mov es:[di+6],dx
  224. mov es:[di+10],si
  225. pop ax              ax:= 'di'
  226. mov es:[di+12],ax
  227. pop ax              ax:= 'es'
  228. mov es:[di+16],ax }
  229.  
  230. pop ds
  231. end;
  232.  
  233. Procedure VLMcheck;
  234. CONST DOS_MULTIPLEX =$2F;
  235. Var regs:registers;
  236.     ccode:byte;
  237.   Function getBinderyAccessLevel:boolean;  { to be replaced by a non-bindery call }
  238.   Type Treq=record
  239.             len      :word;
  240.             subF     :byte;
  241.             end;
  242.        Trep=record
  243.             accLeveL:byte;
  244.             _objId:longInt;
  245.             fill:array[1..20] of byte;
  246.             end;
  247.        TPreq=^Treq;
  248.        TPrep=^Trep;
  249.   Var result:word;
  250.   BEGIN
  251.   With TPreq(GlobalReqBuf)^
  252.    do begin
  253.       subF:=$46;
  254.       len:=sizeOf(Treq)-2;
  255.       end;
  256.   F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result);
  257.   GetBinderyAccessLevel:=(result=0);
  258.   end;
  259.  
  260. Var phdr:^TVLMHeader;
  261.     pVLMcbl:^TVLMcontrolBlockEntry;
  262.     t:word;
  263.  
  264. begin
  265. VLM_EXE_Loaded:=false;
  266. Regs.AX:=$7A20;
  267. Regs.BX:=$0000;
  268. Regs.CX:=$0000;
  269. Intr($2F,Regs);
  270. if regs.AX=$0000
  271.  then begin
  272.       { OK. AX=0000. All seems well. But is it really the 2F VLM handler? }
  273.       phdr:=ptr(regs.es,$0000);
  274.       VLM_EXE_Loaded:=(phdr^.MultiplexIdString[1]='V')
  275.                   and (phdr^.MultiplexIdString[2]='L')
  276.                   and (phdr^.MultiplexIdString[3]='M');
  277.  
  278.       IF VLM_EXE_Loaded
  279.        then begin
  280.             NETX_EXE_loaded:=False;
  281.  
  282.             { Determine whether netx.vlm is loaded }
  283.             NETX_VLM_Loaded:=False;
  284.             t:=0;
  285.             While t<phdr^.ModulesLoaded
  286.              do begin
  287.                 pVLMcbl:=ptr(regs.es,phdr^.ControlBlockOfs+(t*SizeOf(TVLMControlBlockEntry)));
  288.                 IF pVLMcbl^.ID=VLM_ID_NETX
  289.                  then begin
  290.                       t:=$0100; { end of iteration }
  291.                       NETX_VLM_Loaded:=True;
  292.                       end;
  293.                 inc(t);
  294.                 end;
  295.  
  296.             { Set requester proc to VLM entry point }
  297.             @VLMcall:=Ptr(Regs.es,Regs.bx);
  298.             VLMtransientSeg:=regs.es;
  299.  
  300.  { @requesterProc:=@VLMsystemCall; ---------- ERR ------}
  301.    @RequesterProc:=@dos.msdos;
  302.  
  303.             end
  304.       end;
  305. if NOT VLM_EXE_Loaded
  306.  then begin
  307.       NETX_VLM_loaded:=false;
  308.       @RequesterProc:=@dos.msdos;
  309.       NETX_EXE_loaded:=GetBinderyAccessLevel;
  310.       end;
  311. end;
  312.  
  313. Function RealModeIntr(intNo:byte;Var regs:TTregisters):boolean;
  314. begin
  315. Intr(intNo,registers(regs));
  316. RealModeIntr:=true;
  317. end;
  318.  
  319.  
  320.  
  321. Procedure nwMsDos(VAR R:ttregisters);
  322. begin
  323.     msDos(registers(R));
  324. end;
  325.  
  326.  
  327. Procedure F2SystemCall(subf:byte;req_size,rep_size:word;Var result:word);
  328. begin
  329. With GlobalRegisters
  330.  do begin
  331.     CX := Req_size;
  332.     DX := rep_size;
  333.     AH := $f2;
  334.     AL := subf;
  335.     DS := Seg(GlobalReqBuf^);  SI := Ofs(GlobalReqBuf^);
  336.     ES := Seg(GlobalReplyBuf^);DI := Ofs(GlobalReplyBuf^);
  337.     MSDOS(registers(GlobalRegisters));
  338.     Result:=al;
  339.     end;
  340. end;
  341.  
  342. Procedure GetGlobalBufferAddress(VAR Sreq,Oreq,Srep,Orep:Word);
  343. begin
  344. Sreq := Seg(GlobalReqBuf^);
  345. Oreq := Ofs(GlobalReqBuf^);
  346. Srep := Seg(GlobalReplyBuf^);
  347. Orep := Ofs(GlobalReplyBuf^);
  348. end;
  349.  
  350.  
  351. Function GetVLMheader(Var VLMheader:TVLMheader):Boolean;
  352. Var p:^TVLMHeader;
  353. begin
  354. if VLMtransientSeg<>$0000
  355.  then begin
  356.       p:=ptr(VLMtransientSeg,$0000);
  357.       move(p^,VLMheader,SizeOf(TVLMHeader));
  358.       end;
  359. GetVLMHeader:=(VLMtransientSeg<>$0000);
  360. end;
  361.  
  362. Function GetVLMControlBlock(Entry:Byte;
  363.                         Var ControlBlock:TVLMControlBlockEntry):Boolean;
  364.                         { entry: 0 .. VLMheader.ModulesLoaded }
  365. Var ph:^TVLMHeader;
  366.     pcb:^TVLMControlBlockEntry;
  367. begin
  368. if VLMtransientSeg<>$0000
  369.  then begin
  370.       ph:=ptr(VLMtransientSeg,$0000);
  371.       pcb:=ptr(VLMtransientSeg,ph^.ControlBlockOfs+entry*SizeOf(TVLMControlBlockEntry));
  372.       move(pcb^,ControlBlock,SizeOf(TVLMControlBlockEntry));
  373.       end;
  374. GetVLMControlBlock:=(VLMtransientSeg<>$0000);
  375. end;
  376.  
  377. Function nwPtr(s,o:word):Pointer;
  378. begin
  379. nwPtr:=Ptr(s,o);
  380. end;
  381.  
  382. Function MapRealmodeSegment(RSeg:Word):Word;
  383. begin
  384. MapRealmodeSegment:=RSeg;
  385. end;
  386.  
  387. {$ENDIF} {------------- end of real-mode procedures -------------------}
  388.  
  389. {$IFDEF ProtMode}
  390.  
  391. Type    pRealSegItem=^tRealSegItem;
  392.     tRealSegItem=record  {structure to store information}
  393.                      Seg:word;    {about allocated selectors}
  394.                      Sel:Word;
  395.                      prev,next:pRealSegItem;
  396.                      end;
  397.     {we need to allocate selectors which map real-mode segments.}
  398.     {all these selectors are stored in an dynamic list}
  399.     {and are cleand up them at then end of the program}
  400.  
  401. Var GlobalRealReqSeg,
  402.     GlobalRealReplySeg:Word;
  403.     SelectorList:pRealSegItem;
  404.  
  405. Function RealModeIntr (IntNo:Byte;VAR Regs:ttregisters):Boolean;Assembler;
  406. {Simulate a call to the spectified real mode interrupt. The registers passed
  407.  to the real mode code are held in RealModeRegisters. This structure contains
  408.  the register content upon termination of the real mode ISR.
  409.  Returns False if there was an error.}
  410.  
  411.   ASM
  412.         push di
  413.         push es
  414.  
  415.         mov  bh,00               {For DOSX to reset the int controller and A20 line.  Windows ingores it.}
  416.         mov  bl,IntNo              {Tell DPMI which interrupt to simulate}
  417.         xor  cx,cx               {0 bytes to copy to real mode stack}
  418.         les  di,Regs             {Get the real mode structure}
  419.         mov word ptr es:[di+$c],0        {reserved to 0}
  420.         mov word ptr es:[di+$c+2],0
  421.         mov word ptr es:[di+$26],0        {fs to 0}
  422.         mov word ptr es:[di+$28],0        {gs to 0}
  423.         mov word ptr es:[di+$2e],0        {sp to 0}
  424.         mov word ptr es:[di+$30],0        {ss to 0}
  425.  
  426.         mov  ax,$0300            {Function 0300h is simulate real mode interrupt}
  427.         int  31h
  428.  
  429.         jc   @Error              {The carry flag was set, so there was an error}
  430.         mov  ax,True         {Return no error}
  431.         jmp  @AllDone
  432.  
  433.       @Error:
  434.         mov  ax,False        {Return false indicating an error}
  435.  
  436.       @AllDone:
  437.         pop  es
  438.         pop  di
  439.   End;
  440.  
  441. Procedure F2SystemCall(subf:byte;req_size,rep_size:word;Var result:word);
  442. begin
  443. With GlobalRegisters
  444.  do begin
  445.     CX := Req_size;
  446.     DX := rep_size;
  447.     AH := $f2;
  448.     AL := subf;
  449.     DS := GlobalRealReqSeg;                {Use then REAL-MODE segments}
  450.     ES := GlobalRealReplySeg;            {of the global buffers}
  451.     DI := 0;                            {OFFSET always 0 for}
  452.     SI := 0;                            {'GlobalDosAlloc'ated memory}
  453.     if not RealModeIntr($21,GlobalRegisters)
  454.          then RUNERROR(217);
  455.         {DPMI-ERRORS, maybe we should stop the system with the new Errorcode 217}
  456.     Result:=al;
  457.     end;
  458. end;
  459.  
  460. Procedure nwMsDos(VAR R:ttregisters);
  461. begin
  462. if not RealModeIntr($21,R)
  463.  then RUNERROR(217);
  464.  {DPMI-ERRORS, maybe we should stop then system with the new Errorcode 217}
  465. end;
  466.  
  467. Procedure GetGlobalBufferAddress(VAR Sreq,Oreq,Srep,Orep:Word);
  468. begin
  469. Sreq := GlobalRealReqSeg;      {Use the REAL-MODE segments}
  470. Srep := GlobalRealReplySeg;    {of the global buffers}
  471. Oreq := 0;                     {OFFSET always 0 for}
  472. Orep := 0;                     {'GlobalDosAlloc'ated memory}
  473. end;
  474.  
  475. {----- Some low-level functions for DPMI -----------}
  476. TYPE os = record
  477.           o, s : Word;
  478.           end;            {for typecasts}
  479.      LDTStr = record            {Structure of LDT-Elements}
  480.               limit : Word;
  481.               base  : Word;
  482.               data : Array[0..1] of Word;
  483.               end;
  484.  
  485. Procedure Halt218; {runError 218: low-level DPMI-Errors}
  486. begin
  487. RunError(218);
  488. end;
  489.  
  490. {DMPI-Function 0: Allocate LDT Descriptor}
  491. function AllocLDTD(var NEWD : Word) : Word; Assembler;
  492. asm
  493.       xor     ax,ax
  494.       mov     cx,1          {only 1 descriptor needed}
  495.       int     31h           {Call DPMI}
  496.       jnc     @@ok
  497.       Call Halt218          {Error on carry}
  498. @@ok:
  499.       les     di,NEWD       {save descriptor to VAR NEWD}
  500.       mov     es:[di],ax
  501.       xor     ax,ax
  502. end;
  503.  
  504. {DMPI-Function 1: Free LDT Descriptor}
  505. function FreeLDTD(D : Word) : Word; Assembler;
  506. asm
  507.       mov     ax,0001h
  508.       mov     bx,D
  509.       int     31h
  510.       jc      @@Ex          {carry: return Error in ax}
  511.       xor     ax,ax
  512. @@Ex:
  513. end;
  514.  
  515. {DMPI-Function 7: Set Segment Base Address}
  516. function SetSBA(S: Word; BA: LongInt) : Word; Assembler;
  517. asm
  518.       mov     ax,0007h
  519.       mov     bx,S
  520.       mov     cx,word ptr BA+2
  521.       mov     dx,word ptr BA
  522.       int     31h
  523.       jc      @@Ex          {carry: return Error in ax}
  524.       xor     ax,ax
  525. @@Ex:
  526. end;
  527.  
  528. {DMPI-Function 8: Set Segment Limit}
  529. function SetSL(S: Word; L: LongInt) : Word; Assembler;
  530. asm
  531.       mov     ax,0008h
  532.       mov     bx,S
  533.       mov     dx,word ptr L
  534.       mov     cx,word ptr L+2
  535.       int     31h
  536.       jc      @@Ex        {carry: return Error in ax}
  537.       xor     ax,ax
  538. @@Ex:
  539. end;
  540.  
  541. {DMPI-Function 9: Set Descriptor Access Rights}
  542. function SetDAS(S: Word; R: Word) : Word; Assembler;
  543. asm
  544.       mov     ax,0009h
  545.       mov     bx,S
  546.       mov     cx,R
  547.       int     31h
  548.       jc      @@Ex        {carry: return Error in ax}
  549.       xor     ax,ax
  550. @@Ex:
  551. end;
  552.  
  553. {DMPI-Function 11: Get Descriptor}
  554. function GetD(S: Word; var D : LDTStr) : Word; Assembler;
  555. asm
  556.       mov     ax,000Bh
  557.       mov     bx,S
  558.       les     di,D
  559.       int     31h
  560.       jc      @@Ex         {carry: return Error in ax}
  561.       xor     ax,ax
  562. @@Ex:
  563. end;
  564.  
  565.  
  566. {Set then Length of the Descriptor-Segment}
  567. function SetLimit(Sele: Word; L: LongInt) : Word;
  568. var St,R: Word;
  569.     Des : LDTStr;
  570. begin
  571. St:= GetD(Sele, Des);       {get the Descriptor-Entry from LDT}
  572. if St <> 0
  573.  then begin
  574.       SetLimit:= St;        {not in LDT, return Error}
  575.       Exit;
  576.       end;
  577. with Des
  578.  do R := (Data[0] shr 8) or ((Data[1] and $00F0) shl 8);
  579.      {form then rights for the DPMI-9-Call, register cl}
  580. if L > $FFFFF
  581.  then begin                      {> 1MB: Page aligned}
  582.       if L and $FFF <> $FFF
  583.        then begin                {Limit=Length-1!}
  584.             SetLimit := $8021;   {return Error: not page aligned}
  585.             Exit;
  586.             end;
  587.        R:= R or $8000;           {set Page granularity}
  588.        end
  589.  else R:= R and $7FFF;           {set Byte granularity}
  590. St := SetSL(Sele, 0);                 {fist set limit to 0}
  591. if St = 0 then St := SetDAS(Sele, R); {ok, set the new rights}
  592. if St = 0 then St:= SetSL(Sele, L);   {ok, set then limit}
  593. SetLimit := St;                          {return errorcode}
  594. end;
  595.  
  596.  
  597. {get a Selector for a part of then real-mode memory}
  598. function RealMemSel(RealP : Pointer; Limit : LongInt; var Sele : Word) : Word;
  599.   function NP(P : Pointer) : LongInt;
  600.   VAR TC:OS absolute P;
  601.   begin
  602.   NP := (LongInt(TC.S) shl 4)+LongInt(TC.O);
  603.   end;
  604. var St : Word;
  605. begin
  606. St := AllocLDTD(Sele);                    {get a new Selector}
  607. if St = 0
  608.  then begin
  609.       St := SetSBA(Sele, NP(RealP));        {set base addresse to the linear}
  610.       if St = 0
  611.        then begin                    {address of the Real-Segment}
  612.             St := SetLimit(Sele, Limit);        {set the selector-limit}
  613.             if St <> 0
  614.              then if FreeLDTD(Sele)<>0 then;        {on error: free selector}
  615.             end
  616.        else if FreeLDTD(Sele)<>0 then;          {on error: free selector}
  617.       end;
  618. RealMemSel := St;                        {return errorcode}
  619. end;
  620.  
  621. {check if the required selector is already allocated}
  622. Function InSelectorList(S:Word):pRealSegItem;
  623. VAR    li:pRealSegItem;
  624. begin
  625. li:=SelectorList;
  626. while li<>NIL
  627.  do begin
  628.     if li^.Seg=S
  629.      then begin
  630.           InSelectorList:=Li;
  631.           exit;
  632.           end;
  633.     li:=li^.Next;
  634.     end;
  635. InSelectorList:=NIL;
  636. end;
  637.  
  638. {insert a new SelectorItem at start of the list}
  639. Procedure AddToSelectorlist(Segment,Selector:Word);
  640. VAR    li:pRealSegItem;
  641. begin
  642. new(li);
  643. with li^
  644.  do begin
  645.     Seg:=segment;
  646.     Sel:=Selector;
  647.     next:=Selectorlist;
  648.     prev:=NIL;
  649.     end;
  650. Selectorlist^.prev:=li;
  651. Selectorlist:=li;
  652. end;
  653.  
  654. {clean up}
  655. Procedure FreeSelectorList;
  656. VAR li:pRealSegItem;
  657. begin
  658. while Selectorlist<>NIL
  659.  do begin
  660.     li:=selectorlist;
  661.     selectorlist:=li^.next;
  662.     if li^.sel<>0
  663.      then FreeLDTD(li^.Sel);
  664.     dispose(li);
  665.     end;
  666. end;
  667.  
  668. Function MapRealmodeSegment(RSeg:Word):Word;
  669. VAR sel:Word;
  670.     li:pRealSegItem;
  671. begin
  672. li:=InSelectorList(RSeg);
  673. if li=NIL
  674.  then begin
  675.       if RealMemSel(Ptr(RSeg,0),$ffff,Sel)<>0
  676.        then RUNERROR(217);             {something's wrong: Errorcode 217}
  677.       MapRealModeSegment:=Sel;
  678.       AddToSelectorList(Rseg,Sel);
  679.       end
  680.  else MapRealModeSegment:=li^.Sel;
  681. end;
  682.  
  683.  
  684. Function nwPtr(s,o:word):Pointer;
  685. begin
  686.       nwPtr:=Ptr(MapRealModeSegment(s),o);
  687. end;
  688.  
  689.  
  690. {$ENDIF} {----------------- end of protected mode procedures -------------}
  691.  
  692. Var OldExitProc:pointer;
  693.  
  694. Function InRealMode:Boolean;
  695. begin
  696. {$IFDEF Windows}
  697. InRealMode:=(GetWinFlags and wf_PMode)=0;
  698. {$ELSE}
  699.  {$IFDEF ProtMode}
  700.  InRealMode:=False;
  701.  {$ELSE}
  702.  InRealMode:=True;
  703.  {$ENDIF}
  704. {$ENDIF}
  705. end;
  706.  
  707.  
  708. {$F+}
  709. Procedure IntrExit;
  710. begin
  711. ExitProc:=OldExitProc;
  712. {$IFDEF ProtMode}
  713. if GlobalDosFree(Seg(GlobalReqBuf^))<>0 then;     {ignore Errors}
  714. if GlobalDosFree(Seg(GlobalReplyBuf^))<>0 then;
  715. FreeSelectorList;
  716. {$ELSE} {RealMode}
  717. FreeMem(GlobalReqBuf,SizeOf(TintrBuffer));
  718. Freemem(GlobalReplyBuf,Sizeof(TintrBuffer));
  719. {$ENDIF}
  720. end;
  721. {$F-}
  722.  
  723.  
  724. {$IFDEF ProtMode}
  725. VAR w1:Longint absolute GlobalRegisters;
  726. { we only need w1 during the initialisation, so we use the static
  727.   var GlobalRegisters to save 4 bytes of memory :-) }
  728. {$ENDIF}
  729.  
  730. begin
  731. VLM_EXE_Loaded:=false;
  732. NETX_EXE_loaded:=false;
  733. NETX_VLM_loaded:=false;
  734. {$IFDEF ProtMode}
  735. new(SelectorList);
  736. fillchar(Selectorlist^,Sizeof(Selectorlist^),0);
  737. w1:=GlobalDosAlloc(Sizeof(tIntrBuffer));        {alloc REQ-Buffer}
  738. if w1=0
  739.  then runerror(217);                            {DPMI-ERROR, no free Memory}
  740. GlobalReqBuf:=Ptr(loWord(w1),0);                {buffer-address for protected Mode}
  741. GlobalRealReqSeg:=hiWord(w1);                   {REAL-Mode-Segment of the buffer-address}
  742. w1:=GlobalDosAlloc(Sizeof(tIntrBuffer));        {alloc REPLY-Buffer}
  743. if w1=0
  744.  then runerror(217);
  745. GlobalReplyBuf:=Ptr(loWord(w1),0);
  746. GlobalRealReplySeg:=hiWord(w1);
  747. {$else} {RealMode}
  748. new(GlobalReqBuf);
  749. if GlobalReqBuf=NIL
  750.  then RunError(203); {where has all the memory gone?? /Heap-Overflow}
  751. new(GlobalReplyBuf);
  752. if GlobalReplyBuf=NIL
  753.  then RunError(203);
  754. VLMtransientSeg:=$0000;
  755. VLMcheck;
  756. {$endif}
  757. OldExitProc:=ExitProc;
  758. ExitProc:=@IntrExit;
  759. end.
  760.  
  761.  
  762.